COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	@d char_width_end(#)==#]
C00019 00003	AS AN ALTERNATE TO THE ABOVE, TRY USING A REPEAT COMMAND FOR A STRING OF
C00038 00004	@ @<Glob...@>=
C00062 ENDMK
C⊗;
@d char_width_end(#)==#]
@d char_width(#)==width[width_base[#]+char_width_end
@d invalid_width==@'17777777777

@d char_ptr_end(#)==#]
@d char_ptr(#)==width[data_base[#]+char_ptr_end

line for module 110
else
 begin
 q←char_width(cur_font)(p);
 if q≠invalid_width then
   begin
   if char_ptr(cur_font)(p)>0 then do_im_bgly;


q←glyph_ptr[data_base[cur_font]+cur_char]];
if q>0 then {glyph details are in |m_store| but not yet sent on}
  begin


@p function read_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin b←store[s_i]; incr(s_i); read_byte←b;
end;
@#
function read_signed_pair:integer; {returns the next two bytes, signed}
var a,@!b:eight_bits;
begin a←read_byte; b←read_byte;
if a<128 then read_signed_pair←(a*256)+b
else signed_pair←(a-256)*256+b;*256+b;
end;

procedure do_im_bgly(@!c:integer);
var i,q:integer;
begin
im_byte(im_bgly);
im_halfword(cur_font*128+p); {family and member name}
q←pixel_width[data_base[cur_font]+cur_char];
im_halfword(q); {advance width}
q←glyph_ptr[data_base[cur_font]+cur_char]; {actually points to raster start}
im_byte(m_store[q]); {2 bytes for}
incr(q); im_byte(m_store[q]); {raster width, |max_m-min_m+1|}
incr(q); im_byte(m_store[q]); {2 bytes for}
incr(q); im_byte(m_store[q]); {left offset, |min_m|}
incr(q); im_byte(m_store[q]); {2 bytes for}
incr(q); im_byte(m_store[q]); {height, |max_n-min_n+1|}
incr(q); im_byte(m_store[q]); {2 bytes for}
incr(q); im_byte(m_store[q]); {top offset, |-max_n|}
incr(q);

AS AN ALTERNATE TO THE ABOVE, TRY USING A REPEAT COMMAND FOR A STRING OF
IDENTICAL ROWS

@<Store a sequence of |paint| commands...@>=
begin
for i←0 to buf_size do bufb[i]←0;
 {first store the |new_row| information that has been held}
if z≤166 then bufb_byte(n_row+z) else
	begin 
	bufb_byte(new_row); bufb_byte(z div 256); bufb_byte(z mod 256);
	end;
  n_r_flag←false;
repeat 
  bufb_byte(o);
  case o of
sixty_four_cases(paint_0): do_nothing;
paint1:begin p←gf_byte; bufb_byte(p); end;
paint1+1: begin p←gf_byte; bufb_byte(p); p←gf_byte; bufb_byte(p); end;
paint1+2: begin p←gf_byte; bufb_byte(p); p←gf_byte;
	        bufb_byte(p); p←gf_byte; bufb_byte(p); end;
  endcases;
  o←gf_byte;
until o>paint1+3;
dup_flag←true; 
for i←0 to buf_size do if bufb[i]≠bufa[i] then dup_flag←false;
if dup_flag=true then incr(dup_count) else
begin
  if dup_count>0 then 
    begin stow_byte(rep); stow_byte(dup_count); dup_count←0;
    end else
    begin i←0; while bufb[i]≠0 do 
      begin
      p←bufb[i]; stow_byte(p); incr(i);  
      end;
    for i←0 to buf_size do bufa[i]←bufb[i];
    end;
end;
@ @<Glob...@>=
@!bad_char:boolean; {has a non-ASCII character code appeared in this \\{xxx}?}
This page reserved for store to im_press

@p function read_byte:integer; {returns the next byte, unsigned}
var b:eight_bits;
begin b←store[s_i]; incr(s_i); read_byte←b;
end;
@#
function read_signed_pair:integer; {returns the next two bytes, signed}
var a,@!b:eight_bits;
begin a←read_byte; b←read_byte;
if a<128 then read_signed_pair←(a*256)+b
else signed_pair←(a-256)*256+b;*256+b;
end;

@d im_byte(#)==begin write(im_file,#); incr(im_byte_no); end


@p procedure im_signed_pair(@!w:integer);
begin
if w<0 then w←w+@"10000;
im_byte(w div @"100);
im_byte(w mod @"100);
end;
@#
procedure im_word(@!w:integer);
begin
if w>0 then im_byte(w div @"1000000)
else begin
	w:=w+@"40000000;
	w:=w+@"40000000;
	im_byte((w div @"1000000) + 128);
	end;
im_byte((w div @"10000) mod @"100);
im_byte((w div @"100) mod @"100);
im_byte(w mod @"100);
end;

@ @<Send a |bgly|@>=
s_i←glyph_pointer[f,c];
if s_i≤0 then begin
  if s_i<0 then in_gf←false
  else error('Character ',c:1,' in font ',f:1,' does not exist.');
  end else
  begin
  w←read_signed_pair; im_signed_pair(w); {rotation, family, and member};
  w←read_signed_pair; im_signed_pair(w); {advance width}
  w←read_signed_pair; im_signed_pair(w); {width}
  w←read_signed_pair; im_signed_pair(w); {left-offset}
  w←read_signed_pair; im_signed_pair(wr); {heaght}
  w←read_signed_pair; im_signed_pair(w); {top_offset}
  z←read_signed_pair; n_r_flsg←true;
 

@ @<Accept a |boc|...@>=
a←s_i;
incr(total_chars); {a record of the number of characters downloaded}
read_signed_quad; char_code←par;
read_signed_quad; p←par;
c←char_code mod 256;
if c<0 then c←c+256;
print(c:1);
if char_code≠c then
	print(' in family ',(char_code-c) div 256 : 1);
read_signed_quad; min_x_stated←par; read_signed_quad; max_x_stated←par;
read_signed_quad; min_y_stated←par; read_signed_quad; max_y_stated←par;
read_signed_quad; z←par;
min_z←z;
if char_ptr[c]≠p then
	error('previous character pointer should be ',char_ptr[c]:1,
		', not ',p:1,'!');
char_ptr[c]←gf_prev_ptr;
y←max_y_stated;
x←z;

n_r_flag←true; {to handle an immediate skip instruction should one be given}
im_byte(bgly);
par←f*128+c; im_signed_pair(par);


@ @<Translate a |new_row|, |right| or |left| command@>=
begin
n_r_flag←true;
decr(y); z←z+p; x←z;
@<finish translation of the previous paint commands if any@>;
w←z;
if z<min_z then min_z←z;

@<Translate a sequence of paint commands@>=
n←0; dis←0; val←0;
while n<bytes_required do
  begin
  if dis=0 then
    begin
    @<Get two paint commands@>;
    dis←w+b;
    end;
  while dis<8 do
      begin
      val←val+wtab[w]-wtab[dis];
      @<Get two paint commands@>;
      w←dis+w; dis←w+b;
      end;
  if w≥8 then
      begin
      im_byte(val); incr(n); w←w-8; dis←dis-8; val←0;
      end
      else
      begin
      im_byte(val+btab[w]); incr(n); w←0; dis←dis-8; val←0;
      end;
  end;

@<Get two paint commands@>=
if n_r_flag=false then 
  begin 
  if store[s_i]≤paint1+3 then
    begin  stow_op; w←p;
    end else  w←8*bytes_required; {a safety measure}
  end;
if store[s_i]≤paint1+3 then
  begin  stow_op; b←p;
  end else  b←0;
n_r_flag←false;

@d read_byte==begin par←store[s_i]; incr[s_i]; end
@d read_two_bytes==begin read_byte;
	par←par*256+store[s_i]; incr(s_i);
	end
@d read_three_bytes==begin read_two_bytes;
	par←par*256+store[s_i]; incr(s_i);
	end
@d read_signed_quad==begin read_byte; 
	if par<128 then 
	  begin
	  par←par*256+store[s_i]; incr(s_i);
	  par←par*256+store[s_i]; incr(s_i);
	  par←par*256+store[s_i]; incr(s_i);
	  end
	  else
	  begin
	  par←(par-256)*256+store[s_i]; incr(s_i);
	  par←par*256+store[s_i]; incr(s_i);
	  par←par*256+store[s_i]; incr(s_i);
	  end;
	end

@d stow_op==o←store[r_p]; incr(s_i);
	if o>240 then error('bad |store| formulation');
	 p←first_stow_par(o);

@p function first_stow_par(o:eight_bits):integer;
begin case o of
sixty_four_cases(paint_0): first_stow_par←o-paint_0;
paint1,skip1,char_loc,gf_xxx1: read_byte; first_stow_par←par;
paint1+1,skip1+1,gf_xxx1+1: read_two_bytes; first_stow_par←par;
paint1+2,skip1+2,gf_xxx1+2: read_three_bytes; first_stow_par←par;
new_row,gf_xxx1+3,yyy: read_signed_quad; first_stow_par←par;
gf_nop,boc,eoc,gf_pre,gf_post,gf_post_post,undefined_commands: first_stow_par←0;
eighty_three_cases(left_z_83), right_z_0,
	eighty_three_cases(right_z_1): first_stow_par←o-right_z_0;
end;
end;

@<
@<Glob...@>=
@!val:integer; {used to accumulate mask data}
@!dis:integer; {used to measure distance along a row}
@!par:integer; {holding current parameter}
@!char_code:integer; {the current character code}
@!glyph_pointers:array[0..max_fonts,0..127] of integer;
@!store:array[0..store_size] of eight_bits;
@!s_i:integer; {the index to |store|}
@!wtab:array[0..8] of integer; {for black streaks contained within a byte}
@!btab:array[0..8] of integer; {for black streaks going to end of a byte}

@<Set initial values@>=
wtab[0]←256; btab[0]←255;
for i←1 to 8 do 
  begin 
  wtab[i]←wtab[i-1] div 2;
  btab[i]←wtab[i]-1;
  end;

value	wtab	btab
0	256	255
1	128	127
2	64	63
3	32	31
4	16	15
5	8	7
6	4	3
7	2	1
8	1	0

@ @<Translate a |new_row|, |right| or |left| command@>=
begin
n_r_flag←true;
decr(y); z←z+p; x←z;
if z<min_z then min_z←z;
p_c←0; 
  p_val←white; 
  p_array←z;
  incr(p_c);
  p_array←0; {to clear the next |p_c| location}
end

@ @<Translate a |new_row|, |right| or |left| command@>=
begin
n_r_flag←true;
stow_byte(o); stow_par(o);
z←z+p;

p_c←0; 
  p_val←white; 
  p_array←z;
  incr(p_c);
  p_array←0; {to clear the next |p_c| location}
end


@<Store character@>=
o←gf_byte;
if o≤paint1+3 then @<Translate a sequence of |paint| commands,
	until reaching a non-|paint|@>;
if (new_row≤o) and (o≤right_z_83) then
	@<Translate a |new_row|, |right| or |left| command@>
else case o of
	three_cases(skip1): @<Translate a |skip| command@>;
	@t\4@>@<Cases for commands |gf_nop|, |pre|, |post|, |post_post|, |boc|,
		and |eoc|@>@;
	four_cases(gf_xxx1): @<Translate an |gf_xxx| command@>;
	yyy: @<Translate a |yyy| command@>;
	othercases error('undefined command ',o:1,'!')
@.undefined command@>
	endcases